home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / gt1300_1.arc / TIMER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-06-18  |  2.3 KB  |  99 lines
  1. PROGRAM
  2.    timer;
  3.  
  4. TYPE
  5.    STRING10            = STRING[10];
  6.    registerset         = RECORD
  7.                             AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : INTEGER;
  8.                          END;
  9. VAR
  10.    regs                : registerset;
  11.  
  12. (****************************************************************************)
  13. (*                           TIME SERVICE ROUTINES                          *)
  14. (****************************************************************************)
  15.  
  16.    PROCEDURE
  17.       real_time( VAR t : REAL );
  18.    BEGIN
  19.       WITH regs DO BEGIN
  20.          AX := $2C00;
  21.          msdos(regs);
  22.          t :=    (int(hi(CX)) * 360000.0)
  23.                + (int(lo(CX)) * 6000.0)
  24.                + (int(hi(DX)) * 100.0)
  25.                + int(lo(DX));
  26.       END;
  27.    END;
  28.  
  29.    FUNCTION
  30.       Elapsed(VAR start : REAL) : REAL;
  31.    VAR
  32.       curr   : REAL;
  33.    BEGIN
  34.       real_time(curr);
  35.       WHILE (curr < start) DO
  36.          curr:=curr + 4320000.0;
  37.       Elapsed:=curr - start;
  38.    END;
  39.  
  40. VAR
  41.    xp        : INTEGER;
  42.    x,x0,x1   : INTEGER;
  43.    y,y0,y1   : REAL;
  44.    exit_loop : BOOLEAN;
  45.    target    : REAL;
  46.  
  47.    FUNCTION
  48.       fx(d : INTEGER) : REAL;
  49.    VAR
  50.       rs,te  : REAL;
  51.       j,k    : INTEGER;
  52.    BEGIN
  53.       write('.');
  54.       te:=target*10.0;
  55.       real_time(rs);
  56.       FOR j:=1 TO trunc(te) DO
  57.          FOR k:=1 TO d DO;
  58.       fx:=Elapsed(rs);
  59.    END;
  60.  
  61. BEGIN
  62.    ClrScr;
  63.    Writeln('Time Base Calculator.  By: P & M Software Co.');
  64.    writeln;
  65.    Writeln('This program determines the correct setting for the "Millisec Loop Count"');
  66.    Writeln('for your computer.  It will take a few minutes to run, so be patient...');
  67.    writeln;
  68.    Write('WORKING');
  69.    x1:=37;
  70.    target:=200.0;
  71.    REPEAT
  72.       x1:=(x1*2);
  73.       y1:=fx(x1);
  74.    UNTIL (y1 > target);
  75.    x0:=(x1 div 2);
  76.    exit_loop:=FALSE;
  77.    writeln;
  78.    write('.');
  79.    x:=0;
  80.    REPEAT
  81.       xp:=x;
  82.       x:=((x1+x0) div 2);
  83.       writeln(x0,' - ',x,' - ',x1);
  84.       IF (x = xp) THEN
  85.          exit_loop:=TRUE
  86.       ELSE BEGIN
  87.          y:=fx(x);
  88.          IF (y > target) THEN
  89.             x1:=x
  90.          ELSE
  91.             x0:=x;
  92.       END;
  93.    UNTIL (exit_loop);
  94.    writeln;
  95.    x:=((x1+x0+1) div 2);
  96.    writeln('The correct value for the "Millisec Loop Count" is: ',x);
  97.    writeln;
  98. END.
  99.